Neste projeto o objetivo é segmentar clientes de um food delivery. A segmentação permite que profissionais de marketing e product managers possam identificar subconjuntos de público-alvo e assim melhor adaptar suas estratégias.
O dataset utilizado foi cedido pela Data Science Academy e a seguir vamos começar nossa análise.
library(tidyverse)
library(scales)
library(lubridate)
library(ggridges)
library(gghalves)
library(tidytext)
library(tidymodels)
library(wrapr)
library(fpc)
library(wesanderson)
library(skimr)
Vamos importar os dados e visualizar quais são as variáveis que iremos trabalhar
orders_client_raw <- read_csv("data/dataset.csv")
## Parsed with column specification:
## cols(
## id_transacao = col_character(),
## horario_pedido = col_datetime(format = ""),
## localidade = col_double(),
## nome_item = col_character(),
## quantidade_item = col_double(),
## latitude = col_double(),
## longitude = col_double()
## )
glimpse(orders_client_raw)
## Rows: 260,645
## Columns: 7
## $ id_transacao <chr> "0x7901ee", "0x7901ee", "0x7901ee", "0x12b47f", "0x12…
## $ horario_pedido <dttm> 2019-01-16 18:33:00, 2019-01-16 18:33:00, 2019-01-16…
## $ localidade <dbl> 7, 7, 7, 3, 3, 6, 6, 2, 2, 2, 8, 8, 6, 6, 7, 7, 7, 7,…
## $ nome_item <chr> "bebida", "pizza", "sobremesa", "salada", "sobremesa"…
## $ quantidade_item <dbl> 2, 2, 2, 1, 1, 2, 2, 2, 2, 2, 3, 3, 1, 1, 3, 3, 1, 4,…
## $ latitude <dbl> 41.79413, 41.79413, 41.79413, 41.88449, 41.88449, 41.…
## $ longitude <dbl> -88.01014, -88.01014, -88.01014, -87.62706, -87.62706…
A nível de melhor compreender os dados podemos estabelecer um dicionário com o que cada variável representa:
Observamos que a variável nome_item possui um tipo de character, porém é mais indicado trabalhar com a mesma como fator.
orders_client_raw$nome_item_fac <- as.factor(orders_client_raw$nome_item)
glimpse(orders_client_raw)
## Rows: 260,645
## Columns: 8
## $ id_transacao <chr> "0x7901ee", "0x7901ee", "0x7901ee", "0x12b47f", "0x12…
## $ horario_pedido <dttm> 2019-01-16 18:33:00, 2019-01-16 18:33:00, 2019-01-16…
## $ localidade <dbl> 7, 7, 7, 3, 3, 6, 6, 2, 2, 2, 8, 8, 6, 6, 7, 7, 7, 7,…
## $ nome_item <chr> "bebida", "pizza", "sobremesa", "salada", "sobremesa"…
## $ quantidade_item <dbl> 2, 2, 2, 1, 1, 2, 2, 2, 2, 2, 3, 3, 1, 1, 3, 3, 1, 4,…
## $ latitude <dbl> 41.79413, 41.79413, 41.79413, 41.88449, 41.88449, 41.…
## $ longitude <dbl> -88.01014, -88.01014, -88.01014, -87.62706, -87.62706…
## $ nome_item_fac <fct> bebida, pizza, sobremesa, salada, sobremesa, pizza, s…
No R temos um pacote muito interessante que permite observar um geral sobre os dados, com várias estatísticas mais básicas, o skimr.
skim(orders_client_raw)
| Name | orders_client_raw |
| Number of rows | 260645 |
| Number of columns | 8 |
| _______________________ | |
| Column type frequency: | |
| character | 2 |
| factor | 1 |
| numeric | 4 |
| POSIXct | 1 |
| ________________________ | |
| Group variables | None |
Variable type: character
| skim_variable | n_missing | complete_rate | min | max | empty | n_unique | whitespace |
|---|---|---|---|---|---|---|---|
| id_transacao | 0 | 1 | 7 | 8 | 0 | 1e+05 | 0 |
| nome_item | 0 | 1 | 5 | 9 | 0 | 4e+00 | 0 |
Variable type: factor
| skim_variable | n_missing | complete_rate | ordered | n_unique | top_counts |
|---|---|---|---|---|---|
| nome_item_fac | 0 | 1 | FALSE | 4 | sob: 100000, piz: 76122, beb: 46156, sal: 38367 |
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| localidade | 0 | 1 | 5.13 | 2.55 | 1.00 | 3.00 | 5.00 | 7.00 | 9.00 | ▆▆▂▇▆ |
| quantidade_item | 0 | 1 | 2.45 | 1.33 | 1.00 | 1.00 | 2.00 | 4.00 | 5.00 | ▇▆▅▅▂ |
| latitude | 0 | 1 | 41.84 | 0.14 | 41.52 | 41.78 | 41.88 | 41.89 | 42.05 | ▂▁▅▇▂ |
| longitude | 0 | 1 | -87.73 | 0.14 | -88.01 | -87.85 | -87.68 | -87.63 | -87.61 | ▂▂▂▁▇ |
Variable type: POSIXct
| skim_variable | n_missing | complete_rate | min | max | median | n_unique |
|---|---|---|---|---|---|---|
| horario_pedido | 0 | 1 | 2019-01-01 | 2019-12-30 23:59:00 | 2019-07-01 11:49:00 | 76799 |
De mais importante no resumo acima, podemos ver que os dados não possuem valores missing (=D), temos 100.000 valores únicos no id_transacao, temos 4 produtos diferentes.
Localidade possívelmente precisará ser convertida à fator, pois cada valor representa um local diferente de onde o pedido processado. Mas caso venhámos a fazer alguma análise com esta variável podemos converte-la.
orders_client_v1 <- orders_client_raw %>%
mutate(month = month(horario_pedido, label = T, abbr = F),
year = year(horario_pedido))
# visualizando o período referente aos dados
orders_client_v1 %>%
select(year) %>%
unique()
## # A tibble: 1 x 1
## year
## <dbl>
## 1 2019
Vemos que os dados são referentes ao ano de 2019, com dados de todos os meses.
Uma visualização interessante seria visualizar os pedidos ao longo dos meses, podendo entender o que vende mais em determinado período.
# pedidos em cada mês
order_by_month_name <- orders_client_v1 %>%
select(month, nome_item_fac, quantidade_item) %>%
group_by(month, nome_item_fac) %>%
summarise(tot = sum(quantidade_item))
## `summarise()` regrouping output by 'month' (override with `.groups` argument)
# quantidade de pedidos em cada mês do ano de 2019
order_by_month_name
## # A tibble: 48 x 3
## # Groups: month [12]
## month nome_item_fac tot
## <ord> <fct> <dbl>
## 1 janeiro bebida 10792
## 2 janeiro pizza 15999
## 3 janeiro salada 6038
## 4 janeiro sobremesa 22037
## 5 fevereiro bebida 9403
## 6 fevereiro pizza 14151
## 7 fevereiro salada 5448
## 8 fevereiro sobremesa 19599
## 9 março bebida 10374
## 10 março pizza 15683
## # … with 38 more rows
# visualização
order_by_month_name %>%
ggplot(aes(x = tot,
y = reorder(nome_item_fac, tot),
color = nome_item_fac)) +
geom_pointrange(aes(xmin = 0, xmax = tot), fatten = 5) +
scale_color_manual(values = wes_palette(n = 4, name = "BottleRocket2")) +
facet_wrap(~month) +
scale_x_continuous(labels = label_number(scale = 1/1000)) +
guides(fill = F) +
labs(x = "Quantidades de pedidos em milhar",
y = NULL,
color = "Pedidos") +
theme_minimal()
Vimos que ao longo dos meses essa loja recebeu praticamente a mesma quantidade de pedidos todos os meses. Sempre com a menor preferência por salada e a maior preferência por sobremesa.
Como nós também tempos os dados durante as horas do dia, vamos criar uma visualização.
# incluindo a hora do dia para visualizar depois
orders_client_v2 <- orders_client_raw %>%
mutate(month = month(horario_pedido),
year = year(horario_pedido),
hour = hour(horario_pedido))
orders_client_v2 %>%
select(hour) %>%
unique() %>%
arrange(desc(hour))
## # A tibble: 15 x 1
## hour
## <int>
## 1 23
## 2 22
## 3 21
## 4 20
## 5 19
## 6 18
## 7 17
## 8 16
## 9 15
## 10 14
## 11 13
## 12 12
## 13 11
## 14 1
## 15 0
Uma observação referente a sumarização acima é que os pedidos começam as 11 horas e finalizam o atendimento 1h da manhã.
order_by_hour_name <- orders_client_v2 %>%
select(month, hour, nome_item_fac, quantidade_item) %>%
group_by(month, hour, nome_item_fac) %>%
summarise(tot = sum(quantidade_item))
## `summarise()` regrouping output by 'month', 'hour' (override with `.groups` argument)
order_by_hour_name
## # A tibble: 719 x 4
## # Groups: month, hour [180]
## month hour nome_item_fac tot
## <dbl> <int> <fct> <dbl>
## 1 1 0 bebida 650
## 2 1 0 pizza 3417
## 3 1 0 salada 87
## 4 1 0 sobremesa 3504
## 5 1 1 bebida 139
## 6 1 1 pizza 729
## 7 1 1 salada 28
## 8 1 1 sobremesa 757
## 9 1 11 bebida 80
## 10 1 11 pizza 249
## # … with 709 more rows
Vamos visualizar então como foram os pedidos para cada hora do dia ao longo dos meses e do ano de 2019.
order_by_hour_name %>%
ggplot(aes(x = tot,
y = reorder(nome_item_fac, tot),
fill = nome_item_fac)) +
geom_col() +
scale_fill_viridis_d() +
facet_grid(month~hour) + # hora na vertical e mês na horizontal
scale_x_continuous(labels = label_number(scale = 1/1000)) +
guides(fill = F) +
labs(x = "Quantidades de pedidos em milhar",
y = NULL,
color = "Pedidos")
Vemos que os dados seguem um comportamento bastate padrão em todas as horas dos dias de todos os messes do ano.
Conclusões que podemos tirar dos dados até agora: - entre o período de almoço existe um consumo muito grande de sobremesas e salada. - das 17 até as 19 horas se consome muito bebida, pizza e sobremesa. - na 0 hora existe um pico de pedidos de sobremesa e pizza.
Bom, até agora nós visualizamos os pedidos durante o mês e durante as horas nos meses do ano. Mas seria interessante também observar o total da distribuição de pedidos no ano como um todo.
Para isso eu gosto muito de utilizar o pacote ggridgs, com ele podemos observar as várias distribuições de uma forma mais compacta e ainda traçar linhas referentes aos diferentes quartis.
order_by_hour_name %>%
ggplot(aes(x = tot,
y = reorder(nome_item_fac, tot),
fill = nome_item_fac)) +
geom_density_ridges(scale = 3, quantile_lines = TRUE, quantiles = 2) +
scale_fill_viridis_d() +
facet_wrap(~hour, scales = "free_x") +
scale_x_continuous(labels = label_number(scale = 1/1000)) +
guides(fill = F) +
labs(x = "Quantidades de pedidos em milhar",
y = NULL)
Legal, nesse gráfico nós vemos que algumas distribuições nós temos caudas muito longas, e outras parecem ser bimodal. Pode ser interessante visualizar se esse comportamento está sendo provocado por outliers ou se é um comportamento real desses dados.
Para isso chamaremos o bom e velho boxplot/violinoplot, porém adicionamos à distribuição os pontos juntamente que compõe o conjunto. Vamos lá!
order_by_hour_name %>%
ggplot(aes(x = nome_item_fac,
y = tot)) +
geom_half_violin(aes(fill = nome_item_fac), side = 'r', alpha = .3, scale = 3) +
geom_half_point(aes(color = nome_item_fac), side = 'l', size = .6) +
coord_flip() +
labs(y = "Quantidade total de pedidos",
x = NULL) +
guides(color = F, fill = F)
order_by_hour_name %>%
ggplot(aes(x = nome_item_fac,
y = tot)) +
geom_half_boxplot(aes(fill = nome_item_fac), side = 'r', alpha = .3) +
geom_half_point(aes(color = nome_item_fac), side = 'l', size = .6) +
coord_flip() +
labs(y = "Quantidade total de pedidos",
x = NULL) +
guides(color = F, fill = F)
Vamos colocar um highlight na região de outliers
order_by_hour_name %>%
ggplot(aes(x = nome_item_fac,
y = tot)) +
geom_half_boxplot(aes(fill = nome_item_fac), side = 'r', alpha = .3) +
geom_half_point(aes(color = nome_item_fac), side = 'l', size = .6) +
coord_flip() +
annotate(geom = "rect", xmin = 2.7, xmax = 3.1, ymin = 1100 , ymax = 2300,
fill = "grey40", alpha = .2) +
annotate(geom = "rect", xmin = 0.7, xmax = 1.1, ymin = 1900 , ymax = 3700,
fill = "grey40", alpha = .2) +
labs(y = "Quantidade total de pedidos",
x = NULL) +
guides(color = F, fill = F)
theme_minimal()
## List of 93
## $ line :List of 6
## ..$ colour : chr "black"
## ..$ size : num 0.5
## ..$ linetype : num 1
## ..$ lineend : chr "butt"
## ..$ arrow : logi FALSE
## ..$ inherit.blank: logi TRUE
## ..- attr(*, "class")= chr [1:2] "element_line" "element"
## $ rect :List of 5
## ..$ fill : chr "white"
## ..$ colour : chr "black"
## ..$ size : num 0.5
## ..$ linetype : num 1
## ..$ inherit.blank: logi TRUE
## ..- attr(*, "class")= chr [1:2] "element_rect" "element"
## $ text :List of 11
## ..$ family : chr ""
## ..$ face : chr "plain"
## ..$ colour : chr "black"
## ..$ size : num 11
## ..$ hjust : num 0.5
## ..$ vjust : num 0.5
## ..$ angle : num 0
## ..$ lineheight : num 0.9
## ..$ margin : 'margin' num [1:4] 0points 0points 0points 0points
## .. ..- attr(*, "unit")= int 8
## ..$ debug : logi FALSE
## ..$ inherit.blank: logi TRUE
## ..- attr(*, "class")= chr [1:2] "element_text" "element"
## $ title : NULL
## $ aspect.ratio : NULL
## $ axis.title : NULL
## $ axis.title.x :List of 11
## ..$ family : NULL
## ..$ face : NULL
## ..$ colour : NULL
## ..$ size : NULL
## ..$ hjust : NULL
## ..$ vjust : num 1
## ..$ angle : NULL
## ..$ lineheight : NULL
## ..$ margin : 'margin' num [1:4] 2.75points 0points 0points 0points
## .. ..- attr(*, "unit")= int 8
## ..$ debug : NULL
## ..$ inherit.blank: logi TRUE
## ..- attr(*, "class")= chr [1:2] "element_text" "element"
## $ axis.title.x.top :List of 11
## ..$ family : NULL
## ..$ face : NULL
## ..$ colour : NULL
## ..$ size : NULL
## ..$ hjust : NULL
## ..$ vjust : num 0
## ..$ angle : NULL
## ..$ lineheight : NULL
## ..$ margin : 'margin' num [1:4] 0points 0points 2.75points 0points
## .. ..- attr(*, "unit")= int 8
## ..$ debug : NULL
## ..$ inherit.blank: logi TRUE
## ..- attr(*, "class")= chr [1:2] "element_text" "element"
## $ axis.title.x.bottom : NULL
## $ axis.title.y :List of 11
## ..$ family : NULL
## ..$ face : NULL
## ..$ colour : NULL
## ..$ size : NULL
## ..$ hjust : NULL
## ..$ vjust : num 1
## ..$ angle : num 90
## ..$ lineheight : NULL
## ..$ margin : 'margin' num [1:4] 0points 2.75points 0points 0points
## .. ..- attr(*, "unit")= int 8
## ..$ debug : NULL
## ..$ inherit.blank: logi TRUE
## ..- attr(*, "class")= chr [1:2] "element_text" "element"
## $ axis.title.y.left : NULL
## $ axis.title.y.right :List of 11
## ..$ family : NULL
## ..$ face : NULL
## ..$ colour : NULL
## ..$ size : NULL
## ..$ hjust : NULL
## ..$ vjust : num 0
## ..$ angle : num -90
## ..$ lineheight : NULL
## ..$ margin : 'margin' num [1:4] 0points 0points 0points 2.75points
## .. ..- attr(*, "unit")= int 8
## ..$ debug : NULL
## ..$ inherit.blank: logi TRUE
## ..- attr(*, "class")= chr [1:2] "element_text" "element"
## $ axis.text :List of 11
## ..$ family : NULL
## ..$ face : NULL
## ..$ colour : chr "grey30"
## ..$ size : 'rel' num 0.8
## ..$ hjust : NULL
## ..$ vjust : NULL
## ..$ angle : NULL
## ..$ lineheight : NULL
## ..$ margin : NULL
## ..$ debug : NULL
## ..$ inherit.blank: logi TRUE
## ..- attr(*, "class")= chr [1:2] "element_text" "element"
## $ axis.text.x :List of 11
## ..$ family : NULL
## ..$ face : NULL
## ..$ colour : NULL
## ..$ size : NULL
## ..$ hjust : NULL
## ..$ vjust : num 1
## ..$ angle : NULL
## ..$ lineheight : NULL
## ..$ margin : 'margin' num [1:4] 2.2points 0points 0points 0points
## .. ..- attr(*, "unit")= int 8
## ..$ debug : NULL
## ..$ inherit.blank: logi TRUE
## ..- attr(*, "class")= chr [1:2] "element_text" "element"
## $ axis.text.x.top :List of 11
## ..$ family : NULL
## ..$ face : NULL
## ..$ colour : NULL
## ..$ size : NULL
## ..$ hjust : NULL
## ..$ vjust : num 0
## ..$ angle : NULL
## ..$ lineheight : NULL
## ..$ margin : 'margin' num [1:4] 0points 0points 2.2points 0points
## .. ..- attr(*, "unit")= int 8
## ..$ debug : NULL
## ..$ inherit.blank: logi TRUE
## ..- attr(*, "class")= chr [1:2] "element_text" "element"
## $ axis.text.x.bottom : NULL
## $ axis.text.y :List of 11
## ..$ family : NULL
## ..$ face : NULL
## ..$ colour : NULL
## ..$ size : NULL
## ..$ hjust : num 1
## ..$ vjust : NULL
## ..$ angle : NULL
## ..$ lineheight : NULL
## ..$ margin : 'margin' num [1:4] 0points 2.2points 0points 0points
## .. ..- attr(*, "unit")= int 8
## ..$ debug : NULL
## ..$ inherit.blank: logi TRUE
## ..- attr(*, "class")= chr [1:2] "element_text" "element"
## $ axis.text.y.left : NULL
## $ axis.text.y.right :List of 11
## ..$ family : NULL
## ..$ face : NULL
## ..$ colour : NULL
## ..$ size : NULL
## ..$ hjust : num 0
## ..$ vjust : NULL
## ..$ angle : NULL
## ..$ lineheight : NULL
## ..$ margin : 'margin' num [1:4] 0points 0points 0points 2.2points
## .. ..- attr(*, "unit")= int 8
## ..$ debug : NULL
## ..$ inherit.blank: logi TRUE
## ..- attr(*, "class")= chr [1:2] "element_text" "element"
## $ axis.ticks : list()
## ..- attr(*, "class")= chr [1:2] "element_blank" "element"
## $ axis.ticks.x : NULL
## $ axis.ticks.x.top : NULL
## $ axis.ticks.x.bottom : NULL
## $ axis.ticks.y : NULL
## $ axis.ticks.y.left : NULL
## $ axis.ticks.y.right : NULL
## $ axis.ticks.length : 'simpleUnit' num 2.75points
## ..- attr(*, "unit")= int 8
## $ axis.ticks.length.x : NULL
## $ axis.ticks.length.x.top : NULL
## $ axis.ticks.length.x.bottom: NULL
## $ axis.ticks.length.y : NULL
## $ axis.ticks.length.y.left : NULL
## $ axis.ticks.length.y.right : NULL
## $ axis.line : list()
## ..- attr(*, "class")= chr [1:2] "element_blank" "element"
## $ axis.line.x : NULL
## $ axis.line.x.top : NULL
## $ axis.line.x.bottom : NULL
## $ axis.line.y : NULL
## $ axis.line.y.left : NULL
## $ axis.line.y.right : NULL
## $ legend.background : list()
## ..- attr(*, "class")= chr [1:2] "element_blank" "element"
## $ legend.margin : 'margin' num [1:4] 5.5points 5.5points 5.5points 5.5points
## ..- attr(*, "unit")= int 8
## $ legend.spacing : 'simpleUnit' num 11points
## ..- attr(*, "unit")= int 8
## $ legend.spacing.x : NULL
## $ legend.spacing.y : NULL
## $ legend.key : list()
## ..- attr(*, "class")= chr [1:2] "element_blank" "element"
## $ legend.key.size : 'simpleUnit' num 1.2lines
## ..- attr(*, "unit")= int 3
## $ legend.key.height : NULL
## $ legend.key.width : NULL
## $ legend.text :List of 11
## ..$ family : NULL
## ..$ face : NULL
## ..$ colour : NULL
## ..$ size : 'rel' num 0.8
## ..$ hjust : NULL
## ..$ vjust : NULL
## ..$ angle : NULL
## ..$ lineheight : NULL
## ..$ margin : NULL
## ..$ debug : NULL
## ..$ inherit.blank: logi TRUE
## ..- attr(*, "class")= chr [1:2] "element_text" "element"
## $ legend.text.align : NULL
## $ legend.title :List of 11
## ..$ family : NULL
## ..$ face : NULL
## ..$ colour : NULL
## ..$ size : NULL
## ..$ hjust : num 0
## ..$ vjust : NULL
## ..$ angle : NULL
## ..$ lineheight : NULL
## ..$ margin : NULL
## ..$ debug : NULL
## ..$ inherit.blank: logi TRUE
## ..- attr(*, "class")= chr [1:2] "element_text" "element"
## $ legend.title.align : NULL
## $ legend.position : chr "right"
## $ legend.direction : NULL
## $ legend.justification : chr "center"
## $ legend.box : NULL
## $ legend.box.just : NULL
## $ legend.box.margin : 'margin' num [1:4] 0cm 0cm 0cm 0cm
## ..- attr(*, "unit")= int 1
## $ legend.box.background : list()
## ..- attr(*, "class")= chr [1:2] "element_blank" "element"
## $ legend.box.spacing : 'simpleUnit' num 11points
## ..- attr(*, "unit")= int 8
## $ panel.background : list()
## ..- attr(*, "class")= chr [1:2] "element_blank" "element"
## $ panel.border : list()
## ..- attr(*, "class")= chr [1:2] "element_blank" "element"
## $ panel.spacing : 'simpleUnit' num 5.5points
## ..- attr(*, "unit")= int 8
## $ panel.spacing.x : NULL
## $ panel.spacing.y : NULL
## $ panel.grid :List of 6
## ..$ colour : chr "grey92"
## ..$ size : NULL
## ..$ linetype : NULL
## ..$ lineend : NULL
## ..$ arrow : logi FALSE
## ..$ inherit.blank: logi TRUE
## ..- attr(*, "class")= chr [1:2] "element_line" "element"
## $ panel.grid.major : NULL
## $ panel.grid.minor :List of 6
## ..$ colour : NULL
## ..$ size : 'rel' num 0.5
## ..$ linetype : NULL
## ..$ lineend : NULL
## ..$ arrow : logi FALSE
## ..$ inherit.blank: logi TRUE
## ..- attr(*, "class")= chr [1:2] "element_line" "element"
## $ panel.grid.major.x : NULL
## $ panel.grid.major.y : NULL
## $ panel.grid.minor.x : NULL
## $ panel.grid.minor.y : NULL
## $ panel.ontop : logi FALSE
## $ plot.background : list()
## ..- attr(*, "class")= chr [1:2] "element_blank" "element"
## $ plot.title :List of 11
## ..$ family : NULL
## ..$ face : NULL
## ..$ colour : NULL
## ..$ size : 'rel' num 1.2
## ..$ hjust : num 0
## ..$ vjust : num 1
## ..$ angle : NULL
## ..$ lineheight : NULL
## ..$ margin : 'margin' num [1:4] 0points 0points 5.5points 0points
## .. ..- attr(*, "unit")= int 8
## ..$ debug : NULL
## ..$ inherit.blank: logi TRUE
## ..- attr(*, "class")= chr [1:2] "element_text" "element"
## $ plot.title.position : chr "panel"
## $ plot.subtitle :List of 11
## ..$ family : NULL
## ..$ face : NULL
## ..$ colour : NULL
## ..$ size : NULL
## ..$ hjust : num 0
## ..$ vjust : num 1
## ..$ angle : NULL
## ..$ lineheight : NULL
## ..$ margin : 'margin' num [1:4] 0points 0points 5.5points 0points
## .. ..- attr(*, "unit")= int 8
## ..$ debug : NULL
## ..$ inherit.blank: logi TRUE
## ..- attr(*, "class")= chr [1:2] "element_text" "element"
## $ plot.caption :List of 11
## ..$ family : NULL
## ..$ face : NULL
## ..$ colour : NULL
## ..$ size : 'rel' num 0.8
## ..$ hjust : num 1
## ..$ vjust : num 1
## ..$ angle : NULL
## ..$ lineheight : NULL
## ..$ margin : 'margin' num [1:4] 5.5points 0points 0points 0points
## .. ..- attr(*, "unit")= int 8
## ..$ debug : NULL
## ..$ inherit.blank: logi TRUE
## ..- attr(*, "class")= chr [1:2] "element_text" "element"
## $ plot.caption.position : chr "panel"
## $ plot.tag :List of 11
## ..$ family : NULL
## ..$ face : NULL
## ..$ colour : NULL
## ..$ size : 'rel' num 1.2
## ..$ hjust : num 0.5
## ..$ vjust : num 0.5
## ..$ angle : NULL
## ..$ lineheight : NULL
## ..$ margin : NULL
## ..$ debug : NULL
## ..$ inherit.blank: logi TRUE
## ..- attr(*, "class")= chr [1:2] "element_text" "element"
## $ plot.tag.position : chr "topleft"
## $ plot.margin : 'margin' num [1:4] 5.5points 5.5points 5.5points 5.5points
## ..- attr(*, "unit")= int 8
## $ strip.background : list()
## ..- attr(*, "class")= chr [1:2] "element_blank" "element"
## $ strip.background.x : NULL
## $ strip.background.y : NULL
## $ strip.placement : chr "inside"
## $ strip.text :List of 11
## ..$ family : NULL
## ..$ face : NULL
## ..$ colour : chr "grey10"
## ..$ size : 'rel' num 0.8
## ..$ hjust : NULL
## ..$ vjust : NULL
## ..$ angle : NULL
## ..$ lineheight : NULL
## ..$ margin : 'margin' num [1:4] 4.4points 4.4points 4.4points 4.4points
## .. ..- attr(*, "unit")= int 8
## ..$ debug : NULL
## ..$ inherit.blank: logi TRUE
## ..- attr(*, "class")= chr [1:2] "element_text" "element"
## $ strip.text.x : NULL
## $ strip.text.y :List of 11
## ..$ family : NULL
## ..$ face : NULL
## ..$ colour : NULL
## ..$ size : NULL
## ..$ hjust : NULL
## ..$ vjust : NULL
## ..$ angle : num -90
## ..$ lineheight : NULL
## ..$ margin : NULL
## ..$ debug : NULL
## ..$ inherit.blank: logi TRUE
## ..- attr(*, "class")= chr [1:2] "element_text" "element"
## $ strip.switch.pad.grid : 'simpleUnit' num 2.75points
## ..- attr(*, "unit")= int 8
## $ strip.switch.pad.wrap : 'simpleUnit' num 2.75points
## ..- attr(*, "unit")= int 8
## $ strip.text.y.left :List of 11
## ..$ family : NULL
## ..$ face : NULL
## ..$ colour : NULL
## ..$ size : NULL
## ..$ hjust : NULL
## ..$ vjust : NULL
## ..$ angle : num 90
## ..$ lineheight : NULL
## ..$ margin : NULL
## ..$ debug : NULL
## ..$ inherit.blank: logi TRUE
## ..- attr(*, "class")= chr [1:2] "element_text" "element"
## - attr(*, "class")= chr [1:2] "theme" "gg"
## - attr(*, "complete")= logi TRUE
## - attr(*, "validate")= logi TRUE
Ótimo, na sequência acima nós podemos visualizar as regiões com outliers para cada classe de pedido. Como nós estamos tentando entender melhor os dados, não faremos nenhum tratamento neles e levaremos para o modelo final (k-means).
Uma observação interessante é que, realizando essa segmentação, poderemos entender melhor esses grupos que consomem mais saladas e que também bebem mais que outros consumidores (outliers do nossos dados)
Vamos visualizar como está sendo os pedidos referente a cada localidade.
# como dito antes, aqui nós convertemos a localidade para fator
order_by_localidade <- orders_client_v2 %>%
select(localidade, month, hour, nome_item_fac, quantidade_item) %>%
mutate(localidade = as.factor(localidade)) %>%
group_by(localidade, month, hour, nome_item_fac) %>%
summarise(tot = sum(quantidade_item))
## `summarise()` regrouping output by 'localidade', 'month', 'hour' (override with `.groups` argument)
order_by_localidade %>%
ggplot(aes(x = tot,
y = reorder_within(nome_item_fac, tot, localidade),
fill = nome_item_fac)) +
geom_col() +
scale_fill_viridis_d() +
facet_wrap(~localidade, scales = "free_y") +
scale_y_reordered() +
guides(fill = F) +
labs(x = "Quantidade total de pedidos",
y = NULL)
Essas observações com certeza são importantíssimas para uma empresa de delivery, sabendo qual central recebe mais pedidos sobre um determinado produto, fica mais fácil fazer um controle de estoque ou até mesmo optar por não vender determinado produto numa região devido uma saída muito pequena, caso a economia com matéria-prima seja realmente interessante.
O que vemos em relação à nossos dados: - A maioria dos pedidos de salada saem da localidade 1, 3 e 5. - Maior consumo de pizza, sobremesa e bebida do grupo 4, 7 e 9.
Por fim, como temos dados períodos bem completos pode ser interessante dá uma olhada num heatmap da quantidade de pedidos ao longo do ano.
order_by_localidade %>%
ggplot(aes(x = hour,
y = as.factor(month),
fill = tot)) +
geom_tile() +
scale_fill_viridis_c() +
scale_x_continuous(breaks = 0:24) +
coord_equal() +
labs(x = "Hora do dia",
y = "Meses do ano",
fill = "Totais de\nPedidos") +
theme_minimal()
Aqui nós vemos claramente o período do dia em que ocorre maior número de pedidos. E também o vácuo que representa a não ocorrência de nenhum pedido.
Até agora nós fizemos o tivemos um panorama geral dos dados, retirando bons insights. Dentre as variáveis analisadas, uma que não trabalhamos até agora é a id_transacao, até por que a mesma possui 100k valores únicos. Porém, ela é importantíssima para uma empresa de delivery, por que trás a informação do cliente.
Uma forma de analisar uma informação com tamanha multidimensionalidade é tentar agrupa-lós em clusters. Esses métodos não-supervisionados visam agrupar grupos similares, essa similaridade é medida considerando diferentes distâncias: euclidiana, hamming, manhattan, similaridade cosseno…
Cada distância dessa é indicada para um tipo de dado, sendo a mais usada a euclidiana (maioria de dados numéricos). Ao mudar medida de distância damos origem a diferentes algorítmos de clusterização onde você encontra livros inteiros apenas sobre este assunto.
Aqui nós optamos por utilizar o mais popular entre eles, o k-means. Primeiramente vamos pivotar os dados antes de transformá-lo para o formato que o algorítmo recebe.
order_client_clustering <- orders_client_raw %>%
select(id_transacao, nome_item_fac, quantidade_item) %>%
pivot_wider(id_transacao, names_from = nome_item_fac, values_from = quantidade_item, values_fill = 0)
order_client_clustering
## # A tibble: 100,000 x 5
## id_transacao bebida pizza sobremesa salada
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 0x7901ee 2 2 2 0
## 2 0x12b47f 0 0 1 1
## 3 0x6d6979 0 2 2 0
## 4 0x78dd1e 2 2 2 0
## 5 0x4df8ab 0 0 3 3
## 6 0x3be6d3 0 1 1 0
## 7 0x755a0b 3 3 4 1
## 8 0x653685 1 4 4 0
## 9 0x44fe1b 1 2 2 0
## 10 0x8ade21 2 2 3 1
## # … with 99,990 more rows
Como falamos antes, o k-means e outros algorítmos dessa classe modelos, trabalham com distâncias, por isso é extremamente interessante que tenhamos os dados numa mesma escala e unidade. Aqui aplicaremos uma padronização (média = 0 e desvio = 1), assumindo assim que nossa distribuição é uma distribuição normal, o que de fato vimos que na maioria dos casos essa premissa se fez verdade.
# variáveis para padronizar
vars_to_use <- colnames(order_client_clustering)[-1]
pmatrix <- scale(order_client_clustering[, vars_to_use])
pcenter <- attr(pmatrix, "scaled:center") # parâmetro que foi utilizado para centralizar
pscale <- attr(pmatrix, "scaled:scale") # parâmetro que foi utilizado para escalonar
rm_scales <- function(scaled_matrix) {
attr(scaled_matrix, "scaled:center") <- NULL
attr(scaled_matrix, "scaled:scale") <- NULL
scaled_matrix
}
pmatrix <- rm_scales(pmatrix)
Antes de iniciar a implementação do k-means, vale pontuar algumas questões importantes sobre o algorítimo que levaram a adotar o workflow abaixo.
O último ponto trás o conceito de “clusters reais”, que de forma simplificada nada mais é do que um cluster de pontos que não são bem explicados por nenhum outro cluster. Para verificar isso vamos utilizar uma reamostragem bootstrap e rodar o kmeans() várias vezes e em diferentes porções dos dados e medir isso.
E por fim, iremos utilizar o index Calinski-Harabasz para identificar o melhor cluster. Existem váaarias formas de fazer isso, mas eu preferi escolher essa e aqui segue um link caso você queira entender melhor dos pontos matemáticos por trás desse método, muito bem explicado.
# 1 - kmeansruns para encontrar o melhor número de cluster e visualizar o calinski-harabasz index
# 4 - clusterboot() para analisar a estabilidade do cluster
# 2 - col_to_print
# 3 - print_cluster()
# 5 - visualizar cada grupo com um geom_bar() (valor x id_transação, facet/cor/size... por categoria)
##### 1 - kmeansruns nos nossos dados padronizados, com um range em k de 1 a 10, e critério do calinski
clustering_ch <- kmeansruns(pmatrix, krange = 1:10, criterion = "ch")
# best k retornado pelo modelo
clustering_ch$bestk
## [1] 3
# pequeno tratamento nos dados para poder visualizar o CH-index em função do cluster
coef <- clustering_ch$crit
k <- 1:10
data <- tibble(coef, k)
ggplot(data, aes(k, coef)) +
geom_point() +
geom_line(linetype="dashed") +
scale_x_continuous(breaks = 0:10) +
theme_minimal() +
labs(y = "Calinski-Harabasz Index")
Quanto maior o ponto, melhor. Então eu optei por escolher dois dos pontos maiores e visualizar como se dá o comportamento deles quando realizado o bootstrap.
# running o clusterboot pra melhor escolher o k
# k = 3
cboot_3 <- cboot <- clusterboot(pmatrix, clustermethod = kmeansCBI, runs = 100, iter.max = 100, krange = 3, seed = 2020)
## boot 1
## boot 2
## boot 3
## boot 4
## boot 5
## boot 6
## boot 7
## boot 8
## boot 9
## boot 10
## boot 11
## boot 12
## boot 13
## boot 14
## boot 15
## boot 16
## boot 17
## boot 18
## boot 19
## boot 20
## boot 21
## boot 22
## boot 23
## boot 24
## boot 25
## boot 26
## boot 27
## boot 28
## boot 29
## boot 30
## boot 31
## boot 32
## boot 33
## boot 34
## boot 35
## boot 36
## boot 37
## boot 38
## boot 39
## boot 40
## boot 41
## boot 42
## boot 43
## boot 44
## boot 45
## boot 46
## boot 47
## boot 48
## boot 49
## boot 50
## boot 51
## boot 52
## boot 53
## boot 54
## boot 55
## boot 56
## boot 57
## boot 58
## boot 59
## boot 60
## boot 61
## boot 62
## boot 63
## boot 64
## boot 65
## boot 66
## boot 67
## boot 68
## boot 69
## boot 70
## boot 71
## boot 72
## boot 73
## boot 74
## boot 75
## boot 76
## boot 77
## boot 78
## boot 79
## boot 80
## boot 81
## boot 82
## boot 83
## boot 84
## boot 85
## boot 86
## boot 87
## boot 88
## boot 89
## boot 90
## boot 91
## boot 92
## boot 93
## boot 94
## boot 95
## boot 96
## boot 97
## boot 98
## boot 99
## boot 100
# k = 8
cboot_8 <- cboot <- clusterboot(pmatrix, clustermethod = kmeansCBI, runs = 100, iter.max = 100, krange = 8, seed = 2020)
## boot 1
## boot 2
## boot 3
## boot 4
## boot 5
## boot 6
## boot 7
## boot 8
## boot 9
## boot 10
## boot 11
## boot 12
## boot 13
## boot 14
## boot 15
## boot 16
## boot 17
## boot 18
## boot 19
## boot 20
## boot 21
## boot 22
## boot 23
## boot 24
## boot 25
## boot 26
## boot 27
## boot 28
## boot 29
## boot 30
## boot 31
## boot 32
## boot 33
## boot 34
## boot 35
## boot 36
## boot 37
## boot 38
## boot 39
## boot 40
## boot 41
## boot 42
## boot 43
## boot 44
## boot 45
## boot 46
## boot 47
## boot 48
## boot 49
## boot 50
## boot 51
## boot 52
## boot 53
## boot 54
## boot 55
## boot 56
## boot 57
## boot 58
## boot 59
## boot 60
## boot 61
## boot 62
## boot 63
## boot 64
## boot 65
## boot 66
## boot 67
## boot 68
## boot 69
## boot 70
## boot 71
## boot 72
## boot 73
## boot 74
## boot 75
## boot 76
## boot 77
## boot 78
## boot 79
## boot 80
## boot 81
## boot 82
## boot 83
## boot 84
## boot 85
## boot 86
## boot 87
## boot 88
## boot 89
## boot 90
## boot 91
## boot 92
## boot 93
## boot 94
## boot 95
## boot 96
## boot 97
## boot 98
## boot 99
## boot 100
# O campo do objeto retornado pelo clusterboot retorna uma avaliação justamente da estabilidade desses clusters
cboot_3$bootmean
## [1] 1 1 1
cboot_8$bootmean
## [1] 0.6846583 0.9253406 0.8652381 0.7604600 0.6980723 0.9149958 0.8921955
## [8] 0.7588892
O que vemos é que estranhamente o modelo com 3 clusters tem uma estabilidade de 1, em se tratando que o range de valores possíveis dessa técnica é de 0 a 1, provavelmente tem alguma coisa errada com esse número de clusters. Por isso, vamos optar de seguir com 8 klusters, utilizando então o objeto cboot_8.
# groups dos clusters
groups <- cboot_8$result$partition
# colunas que serão utilizadas dataset final com os clusters
cols_to_print <- wrapr::qc(id_transacao, bebida, pizza, sobremesa, salada)
print_clusters <- function(data, groups, columns) {
groupedID <- split(data, groups)
lapply(groupedID, function(df) df[, columns])
}
clusters <- print_clusters(order_client_clustering, groups, cols_to_print)
Nesse ponto, o que temos é uma lista com um dataframe para cada cluster, ou seja, todos os pontos do nosso dataset original nos clusters que o modelo identificou.
Vamos agora fazer algumas visualizações em cada cluster
cluster_1 <- clusters[[1]] %>%
pivot_longer(cols = c("bebida", "pizza", "sobremesa", "salada"), names_to = "pedidos", values_to = "values")
cluster_1 %>%
ggplot(aes(x = values,
y = id_transacao,
color = pedidos)) +
geom_point(position = position_jitter(height = 0, width = .3)) +
scale_x_continuous(breaks = 0:4) +
annotate(geom = "rect", xmin = -0.5, xmax = 4.5, ymax = 16500, ymin = 16400, alpha = .3) +
labs(x = "Número de pedidos realizado pelo cliente",
title = "Pedidos feitos por cada cliente",
subtitle = "A linha horizontal indica a informação de um cliente e seus pedidos") +
theme(axis.text.y.left = element_blank(),
axis.title.y = element_blank(),
axis.ticks.y = element_blank())
cluster_2 <- clusters[[2]] %>%
pivot_longer(cols = c("bebida", "pizza", "sobremesa", "salada"), names_to = "pedidos", values_to = "values")
cluster_2 %>%
ggplot(aes(x = values,
y = id_transacao,
color = pedidos)) +
geom_point(position = position_jitter(height = 0, width = .3)) +
scale_x_continuous(breaks = 0:1) +
annotate(geom = "rect", xmin = -0.5, xmax = 1.5, ymax = 16500, ymin = 16400, alpha = .3) +
labs(x = "Número de pedidos realizado pelo cliente",
title = "Pedidos feitos por cada cliente",
subtitle = "A linha horizontal indica a informação de um cliente e seus pedidos") +
theme(axis.text.y.left = element_blank(),
axis.title.y = element_blank(),
axis.ticks.y = element_blank())
cluster_3 <- clusters[[3]] %>%
pivot_longer(cols = c("bebida", "pizza", "sobremesa", "salada"), names_to = "pedidos", values_to = "values")
cluster_3 %>%
ggplot(aes(x = values,
y = id_transacao,
color = pedidos)) +
geom_point(position = position_jitter(height = 0, width = .3)) +
scale_x_continuous(breaks = 0:5) +
annotate(geom = "rect", xmin = -0.5, xmax = 5.5, ymax = 3500, ymin = 3470, alpha = .3) +
labs(x = "Número de pedidos realizado pelo cliente",
title = "Pedidos feitos por cada cliente",
subtitle = "A linha horizontal indica a informação de um cliente e seus pedidos") +
theme(axis.text.y.left = element_blank(),
axis.title.y = element_blank(),
axis.ticks.y = element_blank())
cluster_4 <- clusters[[4]] %>%
pivot_longer(cols = c("bebida", "pizza", "sobremesa", "salada"), names_to = "pedidos", values_to = "values")
cluster_4 %>%
ggplot(aes(x = values,
y = id_transacao,
color = pedidos)) +
geom_point(position = position_jitter(height = 0, width = .3)) +
scale_x_continuous(breaks = 0:2) +
annotate(geom = "rect", xmin = -0.5, xmax = 2.5, ymax = 11500, ymin = 11430, alpha = .3) +
labs(x = "Número de pedidos realizado pelo cliente",
title = "Pedidos feitos por cada cliente",
subtitle = "A linha horizontal indica a informação de um cliente e seus pedidos") +
theme(axis.text.y.left = element_blank(),
axis.title.y = element_blank(),
axis.ticks.y = element_blank())
cluster_5 <- clusters[[5]] %>%
pivot_longer(cols = c("bebida", "pizza", "sobremesa", "salada"), names_to = "pedidos", values_to = "values")
cluster_5 %>%
ggplot(aes(x = values,
y = id_transacao,
color = pedidos)) +
geom_point(position = position_jitter(height = 0, width = .3)) +
scale_x_continuous(breaks = 0:5) +
annotate(geom = "rect", xmin = -0.5, xmax = 5.5, ymax = 2800, ymin = 2770, alpha = .3) +
labs(x = "Número de pedidos realizado pelo cliente",
title = "Pedidos feitos por cada cliente",
subtitle = "A linha horizontal indica a informação de um cliente e seus pedidos") +
theme(axis.text.y.left = element_blank(),
axis.title.y = element_blank(),
axis.ticks.y = element_blank())
cluster_6 <- clusters[[6]] %>%
pivot_longer(cols = c("bebida", "pizza", "sobremesa", "salada"), names_to = "pedidos", values_to = "values")
cluster_6 %>%
ggplot(aes(x = values,
y = id_transacao,
color = pedidos)) +
geom_point(position = position_jitter(height = 0, width = .3)) +
scale_x_continuous(breaks = 0:3) +
annotate(geom = "rect", xmin = -0.5, xmax = 3.5, ymax = 15500, ymin = 15400, alpha = .3) +
labs(x = "Número de pedidos realizado pelo cliente",
title = "Pedidos feitos por cada cliente",
subtitle = "A linha horizontal indica a informação de um cliente e seus pedidos") +
theme(axis.text.y.left = element_blank(),
axis.title.y = element_blank(),
axis.ticks.y = element_blank())
cluster_7 <- clusters[[7]] %>%
pivot_longer(cols = c("bebida", "pizza", "sobremesa", "salada"), names_to = "pedidos", values_to = "values")
cluster_7 %>%
ggplot(aes(x = values,
y = id_transacao,
color = pedidos)) +
geom_point(position = position_jitter(height = 0, width = .3)) +
scale_x_continuous(breaks = 0:5) +
annotate(geom = "rect", xmin = -0.5, xmax = 5.5, ymax = 17500, ymin = 17400, alpha = .3) +
labs(x = "Número de pedidos realizado pelo cliente",
title = "Pedidos feitos por cada cliente",
subtitle = "A linha horizontal indica a informação de um cliente e seus pedidos") +
theme(axis.text.y.left = element_blank(),
axis.title.y = element_blank(),
axis.ticks.y = element_blank())
cluster_8 <- clusters[[8]] %>%
pivot_longer(cols = c("bebida", "pizza", "sobremesa", "salada"), names_to = "pedidos", values_to = "values")
cluster_8 %>%
ggplot(aes(x = values,
y = id_transacao,
color = pedidos)) +
geom_point(position = position_jitter(height = 0, width = .3)) +
scale_x_continuous(breaks = 0:5) +
annotate(geom = "rect", xmin = -0.5, xmax = 5.5, ymax = 9500, ymin = 9420, alpha = .3) +
labs(x = "Número de pedidos realizado pelo cliente",
title = "Pedidos feitos por cada cliente",
subtitle = "A linha horizontal indica a informação de um cliente e seus pedidos") +
theme(axis.text.y.left = element_blank(),
axis.title.y = element_blank(),
axis.ticks.y = element_blank())